package XPlist;
use strict;

use warnings;
no warnings;

use vars qw($ERROR $XML_head $XML_foot $VERSION @EXPORT_OK %EXPORT_TAGS);
use Carp qw(croak carp);
use Data::Dumper;
use XMLEntities;

use parent qw(Exporter);

@EXPORT_OK = qw(
	parse_plist
	parse_plist_fh
	parse_plist_file
	plist_as_string
	create_from_hash
	create_from_array
	);

%EXPORT_TAGS = (
	'all' => \@EXPORT_OK,
	);

$VERSION = '1.35';

=head1 NAME

XPlist - work with Mac plists at a low level

=head1 SYNOPSIS

	use XPlist;

	my $data  = parse_plist( $text );

		# == OR ==
	my $data  = parse_plist_file( $filename );

		# == OR ==
	open my( $fh ), $filename or die "...";
	my $data  = parse_plist_fh( $fh );


	my $text  = plist_as_string( $data );

	my $plist = create_from_hash(  \%hash  );
	my $plist = create_from_array( \@array );

	my $plist = XPlist::dict->new( \%hash );

	my $perl  = $plist->as_perl;

=head1 DESCRIPTION

This module is a low-level interface to the Mac OS X Property List
(plist) format. You probably shouldn't use this in applications--build
interfaces on top of this so you don't have to put all the heinous
multi-level object stuff where people have to look at it.

You can parse a plist file and get back a data structure. You can take
that data structure and get back the plist as XML. If you want to
change the structure inbetween that's your business. :)

You don't need to be on Mac OS X to use this. It simply parses and
manipulates a text format that Mac OS X uses.

=head2 The Property List format

The MacOS X Property List format is simple XML. You can read the DTD
to get the details.

	http://www.apple.com/DTDs/PropertyList-1.0.dtd

One big problem exists--its dict type uses a flat structure to list
keys and values so that values are only associated with their keys by
their position in the file rather than by the structure of the DTD.
This problem is the major design hinderance in this module. A smart
XML format would have made things much easier.

If the parse_plist encounters an empty key tag in a dict structure
(i.e. C<< <key></key> >> ) the function croaks.

=head2 The XPlist classes

A plist can have one or more of any of the plist objects, and we have
to remember the type of thing so we can go back to the XML format.
Perl treats numbers and strings the same, but the plist format
doesn't.

Therefore, everything C<XPlist> creates is an object of some
sort. Container objects like C<XPlist::array> and
C<XPlist::dict> hold other objects.

There are several types of objects:

	XPlist::string
	XPlist::data
	XPlist::real
	XPlist::integer
	XPlist::date
	XPlist::array
	XPlist::dict

=over 4

=item new( VALUE )

Create the object.

=item value

Access the value of the object. At the moment you cannot change the
value

=item type

Access the type of the object (string, data, etc)

=item write

Create a string version of the object, recursively if necessary.

=item as_perl

Turn the plist data structure, which is decorated with extra
information, into a lean Perl data structure without the value type
information or blessed objects.

=back

=cut

my $Debug = $ENV{PLIST_DEBUG} || 0;

$XML_head =<<"XML";
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
<plist version="1.0">
XML

$XML_foot =<<"XML";
</plist>
XML

my %Readers = (
	"dict"    => \&read_dict,
	"string"  => \&read_string,
	"date"    => \&read_date,
	"real"    => \&read_real,
	"integer" => \&read_integer,
	"string"  => \&read_string,
	"array"   => \&read_array,
	"data"    => \&read_data,
	"true"    => \&read_true,
	"false"   => \&read_false,
	);

my $Options = {ignore => ['<true/>', '<false/>']};

=head1 FUNCTIONS

These functions are available for individual or group import. Nothing
will be imported unless you ask for it.

	use XPlist qw( parse_plist );

	use XPlist qw( :all );

=over 4

=item parse_plist( TEXT )

Parse the XML plist in TEXT and return the C<XPlist>
object.

=cut

# This will change to parse_plist_ref when we create the dispatcher

sub parse_plist {
	my $text = shift;

	my $plist = do {
		if( $text =~ /\A<\?xml/ ) { # XML plists
			# we can handle either 0.9 or 1.0
			$text =~ s|^<\?xml.*?>\s*<!DOC.*>\s*<plist.*?>\s*||;
			$text =~ s|\s*</plist>\s*$||;

			my $text_source = XPlist::TextSource->new( $text );
			read_next( $text_source );
			}
		elsif( $text =~ /\Abplist/ ) { # binary plist
			#require XPlist::ReadBinary;
			my $parser = XPlist::ReadBinary->new( \$text );
			$parser->plist;
			}
		else {
			croak( "This doesn't look like a valid plist format!" );
			}
		};
	}

=item parse_plist_fh( FILEHANDLE )

Parse the XML plist from FILEHANDLE and return the C<XPlist>
data structure. Returns false if the arguments is not a reference.

You can do this in a couple of ways. You can open the file with a
lexical filehandle (since Perl 5.6).

	open my( $fh ), $file or die "...";
	parse_plist_fh( $fh );

Or, you can use a bareword filehandle and pass a reference to its
typeglob. I don't recommmend this unless you are using an older
Perl.

	open FILE, $file or die "...";
	parse_plist_fh( \*FILE );

=cut

sub parse_plist_fh {
	my $fh = shift;

	my $text = do { local $/; <$fh> };

	parse_plist( $text );
	}

=item parse_plist_file( FILE_PATH )

Parse the XML plist in FILE_PATH and return the C<XPlist>
data structure. Returns false if the file does not exist.

Alternately, you can pass a filehandle reference, but that just
calls C<parse_plist_fh> for you.

=cut

sub parse_plist_file {
	my $file = shift;

	if( ref $file ) { return parse_plist_fh( $file ) }

	unless( -e $file ) {
		croak( "parse_plist_file: file [$file] does not exist!" );
		return;
		}

	my $text = do { local $/; open my($fh), $file; <$fh> };

	parse_plist( $text );
	}

=item create_from_hash( HASH_REF )

Create a plist dictionary from the hash reference.

The values of the hash can only be simple scalars--not references.
Reference values are silently ignored.

Returns a string representing the hash in the plist format.

=cut

sub create_from_hash {
	my $hash  = shift;

	return unless UNIVERSAL::isa( $hash, 'HASH' );

	my $string = "$XML_head" . XPlist::dict->write_open . "\n";

	foreach my $key ( keys %$hash ) {
		next if ref $hash->{$key};

		my $bit   = XPlist::dict->write_key( $key ) . "\n";
		my $value = XPlist::string->new( $hash->{$key} );

		$bit  .= $value->write . "\n";

		$bit =~ s/^/\t/gm;

		$string .= $bit;
		}

	$string .= XPlist::dict->write_close . "\n$XML_foot";

	return $string;
	}

=item create_from_array( ARRAY_REF )

Create a plist array from the array reference.

The values of the array can only be simple scalars--not references.
Reference values are silently ignored.

Returns a string representing the array in the plist format.

=cut

sub create_from_array {
	my $array  = shift;

	return unless UNIVERSAL::isa( $array, 'ARRAY' );

	my $string = "$XML_head" . XPlist::array->write_open . "\n";

	foreach my $element ( @$array ) {
		my $value = XPlist::string->new( $element );

		my $bit  .= $value->write . "\n";
		$bit =~ s/^/\t/gm;

		$string .= $bit;
		}

	$string .= XPlist::array->write_close . "\n$XML_foot";

	return $string;
	}

=item read_string

=item read_data

=item read_integer

=item read_date

=item read_real

=item read_true

=item read_false

Reads a certain sort of property list data

=cut

sub read_string  { XPlist::string ->new( XMLEntities::decode( 'all', $_[0] ) )  }
sub read_integer { XPlist::integer->new( $_[0] )  }
sub read_date    { XPlist::date   ->new( $_[0] )  }
sub read_real    { XPlist::real   ->new( $_[0] )  }
sub read_true    { XPlist::true   ->new           }
sub read_false   { XPlist::false  ->new           }

=item read_next

Read the next data item

=cut

sub read_next {
	my $source = shift;

	local $_ = '';
	my $value;

	while( not defined $value ) {
		croak "Couldn't read anything!" if $source->eof;
		$_ .= $source->get_line;

		if( s[^\s* < (string|date|real|integer|data) >
			   \s*(.*?)\s* </\1> ][]sx ) {
			$value = $Readers{$1}->( $2 );
			}
	    elsif( s[^\s* < (dict|array) > ][]x ) {
			$value = $Readers{$1}->( $source );
			}
	    # these next two are some wierd cases i found in the iPhoto Prefs
		elsif( s[^\s* < dict / > ][]x ) {
			$value = XPlist::dict->new();
			}
	    elsif( s[^\s* < array / > ][]x ) {
			$value = XPlist::array->new();
			}
	    elsif( s[^\s* < (true|false) /> ][]x ) {
			$value = $Readers{$1}->();
			}
		}
	$source->put_line($_);
	return $value;
	}

=item read_dict

Read a dictionary

=cut

sub read_dict {
	my $source = shift;

	my %hash;
	local $_ = $source->get_line;
	while( not s|^\s*</dict>|| ) {
		my $key;
		while (not defined $key) {
			if (s[^\s*<key>(.*?)</key>][]s) {
				$key = $1;
				# Bring this back if you want this behavior:
				# croak "Key is empty string!" if $key eq '';
				}
			else {
				croak "Could not read key!" if $source->eof;
				$_ .= $source->get_line;
				}
			}

		$source->put_line( $_ );
		$hash{ $key } = read_next( $source );
		$_ = $source->get_line;
		}

	$source->put_line( $_ );
	return XPlist::dict->new( \%hash );
	}

=item read_array

Read an array

=cut

sub read_array {
	my $source = shift;

	my @array = ();

	local $_ = $source->get_line;
	while( not s|^\s*</array>|| ) {
		$source->put_line( $_ );
		push @array, read_next( $source );
		$_ = $source->get_line;
		}

	$source->put_line( $_ );
	return XPlist::array->new( \@array );
	}

sub read_data {
	my $string = shift;

	require MIME::Base64;

	$string = MIME::Base64::decode_base64($string);

	return XPlist::data->new( $string );
	}

=item plist_as_string

Return the plist data structure as XML in the Mac Property List format.

=cut

sub plist_as_string
	{
	my $object = CORE::shift;

	my $string = $XML_head;

	$string .= $object->write . "\n";

	$string .= $XML_foot;

	return $string;
	}

=item plist_as_perl

Return the plist data structure as an unblessed Perl data structure.
There won't be any C<XPlist> objects in the results.

=cut

sub plist_as_perl
	{
	my $object = CORE::shift;

	my $string = '$VAR = ';

	$string .= $object->as_perl;

	return $string;
	}

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
package XPlist::Source;
sub new {
	my $self = bless { buffer => [], source => $_[1] }, $_[0];
	return $self;
	}

sub eof { (not @{$_[0]->{buffer}}) and $_[0]->source_eof }

sub get_line {
	my $self = CORE::shift;

	local $_ = '';
	while (defined $_ && /^[\r\n\s]*$/) {
		if( @{$self->{buffer}} ) {
			$_ = shift @{$self->{buffer}};
			}
		else {
			$_ = $self->get_source_line;
			}
		}

	return $_;
	}

sub put_line { unshift @{$_[0]->{buffer}}, $_[1] }

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
package XPlist::LineListSource;
use base qw(XPlist::Source);

sub get_source_line { return shift @{$_->{source}} if @{$_->{source}} }

sub source_eof { not @{$_[0]->{source}} }

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
package XPlist::TextSource;
use base qw(XPlist::Source);

sub get_source_line {
	my $self = CORE::shift;
	$self->{source} =~ s/(.*(\r|\n|$))//;
	$1;
	}

sub source_eof { not $_[0]->{source} }

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
package XPlist::Item;
sub type_value { ( $_[0]->type, $_[0]->value ) }

sub value {
	my $ref = $_[0]->type;

	do {
		   if( $ref eq 'array' ) { wantarray ? @{ $_[0] } : $_[0] }
		elsif( $ref eq 'dict'  ) { wantarray ? %{ $_[0] } : $_[0] }
		else                     { ${ $_[0] } }
		};
	}

sub type { my $r = ref $_[0] ? ref $_[0] : $_[0]; $r =~ s/.*:://; $r; }

sub new {
	#print STDERR "Got [@_]\n";

	bless $_[1], $_[0]
	}

sub write_open  { $_[0]->write_either(); }
sub write_close { $_[0]->write_either('/'); }

sub write_either {
	my $slash = defined $_[1] ? '/' : '';

	my $type = $_[0]->type;

	"<$slash$type>";
	}

sub write_empty { my $type = $_[0]->type; "<$type/>"; }

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
package XPlist::Container;
use base qw(XPlist::Item);

sub new {
	my $class = CORE::shift;
	my $item  = CORE::shift;

	if( ref $item ) {
		return bless $item, $class;
		}

	my $empty = do {
		   if( $class =~ m/array$/ ) { [] }
		elsif( $class =~ m/dict$/  ) { {} }
		};

	$class->SUPER::new( $empty );
	}

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
package XPlist::array;
use base qw(XPlist::Container);

sub shift   { CORE::shift @{ $_[0]->value } }
sub unshift { }
sub pop     { CORE::pop @{ $_[0]->value }   }
sub push    { }
sub splice  { }
sub count   { return scalar @{ $_[0]->value } }
sub _elements { @{ $_[0]->value } } # the raw, unprocessed elements
sub values {
	my @v = map { $_->value } $_[0]->_elements;
	wantarray ? @v : \@v
	}

sub as_basic_data {
	my $self = CORE::shift;
	return
		[ map
		{
		eval { $_->can('as_basic_data') } ? $_->as_basic_data : $_
		} @$self
		];
	}

sub write {
	my $self  = CORE::shift;

	my $string = $self->write_open . "\n";

	foreach my $element ( @$self ) {
		my $bit = $element->write;

		$bit =~ s/^/\t/gm;

		$string .= $bit . "\n";
		}

	$string .= $self->write_close;

	return $string;
	}

sub as_perl {
	my $self  = CORE::shift;

	my @array = map { $_->as_perl } $self->_elements;

	return \@array;
	}

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
package XPlist::dict;
use base qw(XPlist::Container);

sub new {
	#print STDERR Data::Dumper::Dumper( $_[1] );

	$_[0]->SUPER::new( $_[1] );
	}

sub delete { delete ${ $_[0]->value }{$_[1]}         }
sub exists { exists ${ $_[0]->value }{$_[1]} ? 1 : 0 }
sub count  { scalar CORE::keys %{ $_[0]->value }     }

sub value {
	my $self = shift;
	my $key  = shift;

	do
		{
		if( defined $key ) {
			my $hash = $self->SUPER::value;

			if( exists $hash->{$key} ) { $hash->{$key}->value }
			else                       { return }
			}
		else { $self->SUPER::value }
		};

	}

sub keys   { my @k = CORE::keys %{ $_[0]->value }; wantarray ? @k : \@k; }
sub values {
	my @v = map { $_->value } CORE::values %{ $_[0]->value };
	wantarray ? @v : \@v;
	}

sub as_basic_data {
	my $self = shift;

	my %dict = map {
		my ($k, $v) = ($_, $self->{$_});
		$k => eval { $v->can('as_basic_data') } ? $v->as_basic_data : $v
		} CORE::keys %$self;

	return \%dict;
	}

sub write_key   { "<key>$_[1]</key>" }

sub write {
	my $self  = shift;

	my $string = $self->write_open . "\n";

	foreach my $key ( $self->keys ) {
		my $element = $self->{$key};

		my $bit  = __PACKAGE__->write_key( $key ) . "\n";
		   $bit .= $element->write . "\n";

		$bit =~ s/^/\t/gm;

		$string .= $bit;
		}

	$string .= $self->write_close;

	return $string;
	}

sub as_perl
	{
	my $self  = CORE::shift;

	my %dict = map {
		my $v = $self->value($_);
		$v = $v->as_perl if eval { $v->can( 'as_perl' ) };
		$_, $v
		} $self->keys;

	return \%dict;
	}


# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
package XPlist::Scalar;
use base qw(XPlist::Item);

sub new { my $copy = $_[1]; $_[0]->SUPER::new( \$copy ) }

sub as_basic_data { $_[0]->value }

sub write { $_[0]->write_open . $_[0]->value . $_[0]->write_close }

sub as_perl { $_[0]->value }

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
package XPlist::date;
use base qw(XPlist::Scalar);

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
package XPlist::real;
use base qw(XPlist::Scalar);

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
package XPlist::integer;
use base qw(XPlist::Scalar);

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
package XPlist::string;
use base qw(XPlist::Scalar);

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
package XPlist::ustring;
use base qw(XPlist::Scalar);

# XXX need to do some fancy unicode checking here

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
package XPlist::data;
use base qw(XPlist::Scalar);

sub write {
	my $self  = shift;

	my $type  = $self->type;
	my $value = $self->value;

	require MIME::Base64;

	my $string = MIME::Base64::encode_base64($value);

	$self->write_open . $string . $self->write_close;
	}

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
package XPlist::Boolean;
use base qw(XPlist::Item);

sub new {
	my $class = shift;

	my( $type ) = $class =~ m/.*::(.*)/g;

	$class->either( $type );
	}

sub either { my $copy = $_[1]; bless \$copy, $_[0]  }

sub write  { $_[0]->write_empty }

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
package XPlist::true;
use base qw(XPlist::Boolean);

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
package XPlist::false;
use base qw(XPlist::Boolean);


=back

=head1 SOURCE AVAILABILITY

This project is in Github:

	git://github.com/briandfoy/mac-propertylist.git

=head1 CREDITS

Thanks to Chris Nandor for general Mac kung fu and Chad Walker for
help figuring out the recursion for nested structures.

Mike Ciul provided some classes for the different input modes, and
these allow us to optimize the parsing code for each of those.

Ricardo Signes added the C<as_basic_types()> methods so you can dump
all the plist junk and just play with the data.

=head1 TO DO

* change the value of an object

* validate the values of objects (date, integer)

* methods to add to containers (dict, array)

* do this from a filehandle or a scalar reference instead of a scalar
	+ generate closures to handle the work.

=head1 AUTHOR

brian d foy, C<< <bdfoy@cpan.org> >>

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2004-2011 brian d foy.  All rights reserved.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 SEE ALSO

http://www.apple.com/DTDs/PropertyList-1.0.dtd

=cut

"See why 1984 won't be like 1984";

#------------------------------------------------------------------------------
#------------------------------------------------------------------------------
#------------------------------------------------------------------------------

package XPlist::ReadBinary;
use strict;
use warnings;

use vars qw( $VERSION );

use Carp;
use Data::Dumper;
use Encode            qw(decode);
use XPlist;
use Math::BigInt;
use MIME::Base64      qw(decode_base64);
use POSIX             qw(SEEK_END SEEK_SET);
use XMLEntities       ();

$VERSION = '1.35';

__PACKAGE__->_run( @ARGV ) unless caller;

=head1 NAME

XPlist::ReadBinary - read binary property list files

=head1 SYNOPSIS

	# use directly
	use XPlist::ReadBinary;

	my $parser = XPlist::ReadBinary->new( $file );

	my $plist = $parser->plist;


	# use indirectly, automatically selects right reader
	use Mac::PropertyList;

	my $plist = parse_plist_file( $file );

=head1 DESCRIPTION

This module is a low-level interface to the Mac OS X Property List
(plist) format.  You probably shouldn't use this in
applications---build interfaces on top of this so you don't have to
put all the heinous multi-level object stuff where people have to look
at it.

You can parse a plist file and get back a data structure. You can take
that data structure and get back the plist as XML (but not binary
yet).  If you want to change the structure inbetween that's your
business. :)

See C<Mac::PropertyList> for more details.

=head2 Methods

=over 4

=item new( FILENAME | SCALAR_REF | FILEHANDLE )

Opens the data source, doing the right thing for filenames,
scalar references, or a filehandle.

=cut

sub new {
	my( $class, $source ) = @_;

	my $self = bless { source => $source }, $class;

	$self->_read;

	$self;
	}

sub _source          { $_[0]->{source}             }
sub _fh              { $_[0]->{fh}                 }
sub _trailer         { $_[0]->{trailer}            }
sub _offsets         { $_[0]->{offsets}            }
sub _object_ref_size { $_[0]->_trailer->{ref_size} }

=item plist

Returns the C<Mac::PropertyList> data structure.

=cut

sub plist            { $_[0]->{parsed}             }

sub _object_size
	{
	$_[0]->_trailer->{object_count} * $_[0]->_trailer->{offset_size}
	}

sub _read {
	my( $self, $thingy ) = @_;

	$self->{fh} = $self->_get_filehandle;
	$self->_read_plist_trailer;

	$self->_get_offset_table;

    my $top = $self->_read_object_at_offset( $self->_trailer->{top_object} );

    $self->{parsed} = $top;
	}

sub _get_filehandle {
	my( $self, $thingy ) = @_;

	my $fh;

	if( ! ref $self->_source ) { # filename
		open $fh, "<", $self->_source
			or die "Could not open [@{[$self->_source]}]! $!";
		}
	elsif( ref $self->_source eq ref \ ''  ) { # scalar ref
		open $fh, "<", $self->_source or croak "Could not open file! $!";
		}
	elsif( ref $self->_source ) { # filehandle
		$fh = $self->_source;
		}
	else {
		croak( 'No source to read from!' );
		}

	$fh;
	}

sub _read_plist_trailer
	{
	my $self = shift;

	seek $self->_fh, -32, SEEK_END;

	my $buffer;
	read $self->_fh, $buffer, 32;
	my %hash;

	@hash{ qw( offset_size ref_size object_count top_object table_offset ) }
		= unpack "x6 C C (x4 N)3", $buffer;

	$self->{trailer} = \%hash;
	}

sub _get_offset_table
	{
	my $self = shift;

    seek $self->_fh, $self->_trailer->{table_offset}, SEEK_SET;

	my $try_to_read = $self->_object_size;

    my $raw_offset_table;
    my $read = read $self->_fh, $raw_offset_table, $try_to_read;

	croak "reading offset table failed!" unless $read == $try_to_read;

    my @offsets = unpack ["","C*","n*","(H6)*","N*"]->[$self->_trailer->{offset_size}], $raw_offset_table;

	$self->{offsets} = \@offsets;

    if( $self->_trailer->{offset_size} == 3 )
    	{
		@offsets = map { hex } @offsets;
   	 	}

	}

sub _read_object_at_offset {
	my( $self, $offset ) = @_;

	my @caller = caller(1);

    seek $self->_fh, ${ $self->_offsets }[$offset], SEEK_SET;

    $self->_read_object;
	}

# # # # # # # # # # # # # #

BEGIN {
my $type_readers = {

	0 => sub { # the odd balls
		my( $self, $length ) = @_;

        # Bug #63683 for Mac-PropertyList: Mac::PropertyList::ReadBinary returns unblessed data types
        # https://rt.cpan.org/Public/Bug/Display.html?id=63683
        # applies bugfix by Hal Pomeranz hal@deer-run.com

        return XPlist::false->new if ($length == 8);
        return XPlist::true->new if ($length == 9);

		my %hash = (
			 0 => [ qw(null  0) ],
			 #8 => [ qw(false 0) ],
			 #9 => [ qw(true  1) ],
			15 => [ qw(fill 15) ],
			);

		return $hash{ $length } || [];
    	},

	1 => sub { # integers
		my( $self, $length ) = @_;
		croak "Integer > 8 bytes = $length" if $length > 3;

		my $byte_length = 1 << $length;

		my( $buffer, $value );
		read $self->_fh, $buffer, $byte_length;

		my @formats = qw( C n N NN );
		my @values = unpack $formats[$length], $buffer;

		if( $length == 3 )
			{
			my( $high, $low ) = @values;

			my $b = Math::BigInt->new($high)->blsft(32)->bior($low);
			if( $b->bcmp(Math::BigInt->new(2)->bpow(63)) > 0)
				{
				$b -= Math::BigInt->new(2)->bpow(64);
				}

			@values = ( $b );
			}

		return XPlist::integer->new( $values[0] );
		},

	2 => sub { # reals
		my( $self, $length ) = @_;
		croak "Real > 8 bytes" if $length > 3;
		croak "Bad length [$length]" if $length < 2;

		my $byte_length = 1 << $length;

		my( $buffer, $value );
		read $self->_fh, $buffer, $byte_length;

		my @formats = qw( a a f> d> );
		my @values = unpack $formats[$length], $buffer;

		return XPlist::real->new( $values[0] );
		},

	3 => sub { # date
		my( $self, $length ) = @_;
		croak "Date != 8 bytes" if $length != 3;
		my $byte_length = 1 << $length;

		my( $buffer, $value );
		read $self->_fh, $buffer, $byte_length;

		my @values = unpack 'd>', $buffer;

		$self->{MLen} += 9;
        
        # [20120506] fpi
        # does not work
        # WAS:
		#my $adjusted_time = POSIX::strftime(
		#	"%FT%H:%M:%SZ",
		#	gmtime( 978307200 + $values[0])
		#	);
		return XPlist::date->new( $values[0] );
		},

	4 => sub { # binary data
		my( $self, $length ) = @_;

		my( $buffer, $value );
		read $self->_fh, $buffer, $length;

		return XPlist::data->new( $buffer );
		},

	5 => sub { # utf8 string
		my( $self, $length ) = @_;

		my( $buffer, $value );
		read $self->_fh, $buffer, $length;

		# pack to make it unicode
		$buffer = XMLEntities::decode(
			'all',
			pack "U0C*", unpack "C*", $buffer
			);

		return XPlist::string->new( $buffer );
		},

	6 => sub { # unicode string
		my( $self, $length ) = @_;

		my( $buffer, $value );
		read $self->_fh, $buffer, 2 * $length;

		$buffer = XMLEntities::decode(
			'all',
			Encode::decode( "UTF-16BE", $buffer )
			);

		return XPlist::ustring->new( $buffer );
		},

	a => sub { # array
		my( $self, $elements ) = @_;

		my @objects = do {
			my $buffer;
			read $self->_fh, $buffer, $elements * $self->_object_ref_size;
			unpack(
				($self->_object_ref_size == 1 ? "C*" : "n*"), $buffer
				);
			};

		my @array =
			map { $self->_read_object_at_offset( $objects[$_] ) }
			0 .. $elements - 1;

		return XPlist::array->new( \@array );
		},

	d => sub { # dictionary
		my( $self, $length ) = @_;

		my @key_indices = do {
			my $buffer;
			my $s = $self->_object_ref_size;
			read $self->_fh, $buffer, $length * $self->_object_ref_size;
			unpack(
				($self->_object_ref_size == 1 ? "C*" : "n*"), $buffer
				);
			};

		my @objects = do {
			my $buffer;
			read $self->_fh, $buffer, $length * $self->_object_ref_size;
			unpack(
				($self->_object_ref_size == 1 ? "C*" : "n*"), $buffer
				);
			};

		my %dict = map {
			my $key   = $self->_read_object_at_offset($key_indices[$_])->value;
			my $value = $self->_read_object_at_offset($objects[$_]);
			( $key, $value );
			} 0 .. $length - 1;

		return XPlist::dict->new( \%dict );
		},
	};

sub _read_object
	{
	my $self = shift;

    my $buffer;
    croak "read() failed while trying to get type byte! $!"
    	unless read( $self->_fh, $buffer, 1) == 1;

    my $length = unpack( "C*", $buffer ) & 0x0F;

    $buffer    = unpack "H*", $buffer;
    my $type   = substr $buffer, 0, 1;

	$length = $self->_read_object->value if $type ne "0" && $length == 15;

	my $sub = $type_readers->{ $type };
	my $result = eval { $sub->( $self, $length ) };
	croak "$@" if $@;

    return $result;
	}

}

=back

=head1 SEE ALSO

Some of the ideas are cribbed from CFBinaryPList.c

	http://opensource.apple.com/source/CF/CF-550/CFBinaryPList.c

=head1 SOURCE AVAILABILITY

This project is in Github:

	git://github.com/briandfoy/mac-propertylist.git

=head1 CREDITS

=head1 AUTHOR

brian d foy, C<< <bdfoy@cpan.org> >>

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2004-2011 brian d foy.  All rights reserved.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

"See why 1984 won't be like 1984";

#------------------------------------------------------------------------------
